home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fritz: All Fritz
/
All Fritz.zip
/
All Fritz
/
FILES
/
UTILENUS
/
MARXMENU.LZH
/
MENUS.EXE
/
SLIDE.MNU
< prev
next >
Wrap
Text File
|
1990-11-11
|
9KB
|
419 lines
Comment
=======================================
Slide.mnu
The object of this game is to move the tiles into numerical order.
The shuffle feature does not generate a truly random order, it just
starts you at a different place. Marc is going to work on the RANDOM
function in MarxMenu to work better.
Enjoy!
KLM (06-01-90)
Kevin L. Moore
Computer Tyme
(417)866-1665
(417)546-3130
=======================================
EndComment
Var
TileArr Row Col TmpArr OldCol OldRow ClearChar
MainScreenForeColor MainScreenBackColor
TitleForeColor TitleBackColor
WindowBorderForeColor WindowBorderBackColor
WindowInsideForeColor WindowInsideBackColor
TileForeColor TileBackColor
TileNumForeColor TileNumBackColor
MessageWinBorderForeColor MessageWinBorderBackColor
MessageWinInsideForeColor MessageWinInsideBackColor
Const
MaxRow = 4
MaxCol = 4
Main
Procedure Setup
if ColorScreen
MainScreenForeColor = White
MainScreenBackColor = Blue
TitleForeColor = Yellow
TitleBackColor = Mag
WindowBorderForeColor = LRed
WindowBorderBackColor = Brown
WindowInsideForeColor = Blue
WindowInsideBackColor = Brown
TileForeColor = Blue
TileBackColor = Brown
TileNumForeColor = White
TileNumBackColor = Blue
MessageWinBorderForeColor = Green
MessageWinBorderBackColor = Brown
MessageWinInsideForeColor = Yellow
MessageWinInsideBackColor = Brown
ClearChar = 32
else
MainScreenForeColor = Grey
MainScreenBackColor = Black
TitleForeColor = Black
TitleBackColor = Grey
WindowBorderForeColor = White
WindowBorderBackColor = Brown
WindowInsideForeColor = White
WindowInsideBackColor = Brown
TileForeColor = Green
TileBackColor = Black
TileNumForeColor = Black
TileNumBackColor = Grey
MessageWinBorderForeColor = Green
MessageWinBorderBackColor = Brown
MessageWinInsideForeColor = Yellow
MessageWinInsideBackColor = Brown
ClearChar = 177
endif
UseArrows Off
TextColor MainScreenForeColor MainScreenBackColor
ClearScreen ClearChar
TextColor TitleForeColor TitleBackColor
GotoXY 1 1
ClearLine
GotoXY 63 1
Write 'Slide Puzzle 1.00'
GotoXY 1 24
ClearLine
WriteCenter 'F1 - Panic Button * F10 - Shuffle * ESC - Exit '
GotoXY 1 25
ClearLine
WriteCenter '(C) Copyright 1990 Computer Tyme * All rights reserved'
ClockColor TitleForeColor TitleBackColor
ClockPos 1 1
Explode Off
Shadow Off
BlockBox
BoxBorderColor WindowBorderForeColor WindowBorderBackColor
BoxInsideColor WindowInsideForeColor WindowInsideBackColor
DrawBox 20 3 45 19
DrawBoard
Shuffle
NumberBoard
EndProc ;Setup
;---
Procedure DrawBoard
Var X Y
TextColor TileForeColor TileBackColor
X = 1
While X < (MaxRow + 1)
GotoXY 1, ((X * 4) - 2)
Writeln ' ██████ ██████ ██████ ██████'
Writeln ' ██████ ██████ ██████ ██████'
Write ' ██████ ██████ ██████ ██████'
X = X + 1
EndWhile
EndProc ;DrawBoard
;---
Procedure NumberBoard
Var X Y
TextColor TileNumForeColor TileNumBackColor
X = 1
While X < (MaxRow + 1)
Y = 1
While Y < (MaxCol + 1)
NumberTile (X, Y)
Y = Y + 1
EndWhile
X = X + 1
EndWhile
DrawEmptyTile
EndProc ;NumberBoard
;---
Procedure DrawEmptyTile
NoBoxBorder
BoxInsideColor TileBackColor TileBackColor
DrawBox (((Col + 3) * 7) + 1) (((Row + 1) * 4) - 3) 6 3
EndProc ;DrawEmptyTile
;---
Procedure Shuffle
Var X Y C Seed
BlockBox
BoxInsideColor Yellow Brown
DrawBox 27 10 30 3
WriteCenter 'Shuffling . . .'
Seed = Random
C = 1
While C < ((MaxRow * MaxCol) + 1)
TmpArr[C] = C
C = C + 1
EndWhile
C = 0
X = 1
While X < (MaxRow + 1)
Y = 1
While Y < (MaxCol + 1)
TileArr[X,Y] = 99
While TileArr[X,Y] = 99
C = ( Random Mod (MaxRow * MaxCol)) + 1
if TmpArr[C] <> 0
If C = (MaxRow * MaxCol)
TileArr[X,Y] = 0
Row = X
Col = Y
else
TileArr[X,Y] = C
endif
TmpArr[C] = 0
endif
EndWhile
Y = Y + 1
EndWhile
X = X + 1
EndWhile
EraseTopWindow
EndProc ;Shuffle
;---
Procedure SlideRight
if Col > 1
TileArr[Row, Col] = Tilearr[Row, Col - 1]
OldRow = Row
OldCol = Col
TileArr[Row, Col - 1] = 0
Col = Col - 1
MoveTile
endif
EndProc ;SlideRight
;---
Procedure SlideLeft
If Col < MaxCol
TileArr[Row, Col] = TileArr[Row, Col + 1]
OldCol = Col
OldRow = Row
TileArr[Row, Col + 1] = 0
Col = Col + 1
MoveTile
endif
EndProc ;SlideLeft
;---
Procedure SlideUp
If Row < MaxRow
TileArr[Row, Col] = TileArr[Row + 1, Col]
OldCol = Col
OldRow = Row
TileArr[Row + 1, Col] = 0
Row = Row + 1
MoveTile
endif
EndProc ;SlideUp
;---
Procedure SlideDown
If Row > 1
TileArr[Row, Col] = TileArr[Row - 1, Col]
OldRow = Row
OldCol = Col
TileArr[Row - 1, Col] = 0
Row = Row - 1
MoveTile
endif
EndProc ;SlideDown
;---
Procedure MoveTile
EraseTopWindow
NumberTile (OLdRow, OldCol)
DrawEmptyTile
if CheckForWin
AdmitDefeat
ClearScreen
if AskYesNo(' Play again')
Shuffle
DrawBoard
else
ExitMenu
endif
endif
EndProc ;MoveTile
;---
Procedure NumberTile (X, Y)
TextColor TileNumForeColor TileNumBackColor
GotoXY ((Y * 7) + 4) ((X * 4) - 1)
If TileArr[X, Y] < 10 then Write ' '
Write TileArr[X,Y]
EndProc ;NumberTile
;---
Procedure CheckForWin
Var X Y C
C = 0
X = 1
While X < (MaxRow + 1)
Y = 1
While Y < (MaxCol + 1)
C = C + 1
if (TileArr[X,Y] <> 0)
if TileArr[X,Y] <> C then Return False
endif
Y = Y + 1
EndWhile
X = X + 1
EndWhile
Return True
EndProc ;CheckForWin
;---
Procedure AdmitDefeat
BlockBox
BoxBorderColor MessageWinBorderForeColor MessageWinBorderBackColor
BoxInsideColor MessageWinInsideForeColor MessageWinInsideBackColor
Drawbox 27 11 31 3
WriteCenter 'You Win !!!'
Write Char(7)
Write Char(7)
Wait(150)
EndProc ;AdmitDefeat
;---
Procedure AskYesNo (Question)
Var YesNo
Write ' ',Question,' [Y,N] ? '
YesNo = UpperCase(ReadKey)
YesNo = YesNo = 'Y'
if YesNo
Write 'Yes'
else
Write 'No'
endif
Wait 50
EraseTopWindow
Return (YesNo)
EndProc ;AskYesNo
;---
Procedure PanicButton
Var AllClear
NoBoxBorder
ClockPos 0,0
BoxInsideColor White Blue
DrawBox 1 1 80 25
Writeln 'SuperCalc 1.00 Memory: 52163'
Writeln '1 A B C D E F G'
Writeln '1'
Writeln '2'
Writeln '3'
Writeln '4'
Writeln '5'
Writeln '6'
Writeln '7'
Writeln '8'
Writeln '9'
Writeln '10'
Writeln '11'
Writeln '12'
Writeln '13'
Writeln '14'
Writeln '15'
Writeln '16'
Writeln '17'
Writeln '18'
Writeln '19'
Writeln 'A3 Empty No file'
Writeln
Writeln
Write 'F2-Save F3-Load F7-Formula F8-AutoCalc F9-Recalc F10-Menu Ins-Block Alt-X-Exit'
AllClear = ReadKey
EraseTopWindow
ClockColor TitleForeColor TitleBackColor
ClockPos 1 1
EndProc ;PanicButton
;---
Procedure Main
Var Key
Setup
Repeat
Key = ReadKey
if Key = Char(4) then SlideRight
if Key = Char(19) then SlideLeft
if Key = Char(5) then SlideUp
if Key = Char(24) then SlideDown
if Key = F10
Shuffle
EraseTopWindow
NumberBoard
endif
if Key = F1 then PanicButton
Until Key = ESC
EndProc ;Main